unit HostFileSystemForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MsgBaseForm,
  StdCtrls, Buttons, ComCtrls, Mask, ExtCtrls, unitCommonTypes, unitCommonDataStruct, unitCommonClasses, unitMsgObj,
  ImageList, ImgList;

type
  TfrmHostFileSystem = class(TfrmMsgBase)
    leCurPath: TLabeledEdit;
    lvPathContent: TListView;
    bOK: TBitBtn;
    bClose: TBitBtn;
    ilMain: TImageList;
    procedure leCurPathKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure lvPathContentDblClick(Sender: TObject);
    procedure bOKClick(Sender: TObject);
  private
    FOnlyDir: Boolean;
    FCurPath: TSerialObj;
    FSelPaths: TCommStrArr;
    { Private declarations }
    procedure ProcHostFileSystem(msg: TMsg);
    procedure RequestPath(path: CommonString);
  protected
    procedure DoProcMsg(msg: TMsg); override;
  public
    { Public declarations }
    procedure FuncStart; override;
    procedure FuncStop; override;

    property OnlyDir: Boolean read FOnlyDir write FOnlyDir;
    property SelPaths: TCommStrArr read FSelPaths;
  end;

implementation

uses unitSvrMngCommon, unitObjPool, unitShareFileObjs, unitClassIDDef, unitMisc, unitUniqueDataCommon, unitErrCodeDef;

const
  ID_FORMPOS: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SubType: IDSUBTYPE_RECORD;
    SubID: (IDBuf: ($21, $64, $B4, $2A, $E2, $2D, $4A, $70, $84, $54, $1F, $BE, $5B, $0A))));
  ID_INITPATH: TID_OBJ = (IDDetail: (ObjType: OBJTYPE_ID; SubType: IDSUBTYPE_RECORD;
    SubID: (IDBuf: ($21, $64, $B4, $2A, $E2, $2D, $4A, $70, $84, $54, $1F, $BE, $5B, $0B))));

{$R *.dfm}

procedure TfrmHostFileSystem.bOKClick(Sender: TObject);
var
  i: integer;
  s: CommonString;
begin
  s := RegularPath(leCurPath.Text);
  SetLength(FSelPaths, 0);
  for i := 0 to lvPathContent.Items.Count - 1 do
    if lvPathContent.Items.Item[i].Selected then
      case lvPathContent.Items.Item[i].ImageIndex of
        0, 1:
          AddStrToArr(FSelPaths, RegularPath(s + lvPathContent.Items.Item[i].Caption));
        2:
          AddStrToArr(FSelPaths, s + lvPathContent.Items.Item[i].Caption);
      end;
  if (Length(FSelPaths) = 0) and FOnlyDir then
    AddStrToArr(FSelPaths, s);
  if Length(FSelPaths) > 0 then
    ModalResult := mrOK;
end;

procedure TfrmHostFileSystem.DoProcMsg(msg: TMsg);
begin
  case msg.MsgID of
    MESID_UNIQUEDATA_ADDOBJ:
      if msg.Error <> ERRCODE_NOERROR then
      begin
        lvPathContent.ViewStyle := vsReport;
        lvPathContent.Columns.Clear;
        lvPathContent.Columns.Add.Width := 400;
        lvPathContent.Items.Clear;
        lvPathContent.Items.Add.Caption := ErrCodeToStr(msg.Error);
      end;
    MESID_SVRMNG_HOSTFILESYSTEMINFO:
      ProcHostFileSystem(msg);
  else
    inherited;
  end;
end;

procedure TfrmHostFileSystem.FuncStart;
var
  s4: TSize4DataSet;
  so: TStringObj;
begin
  inherited;
  if FCurPath = nil then
    FCurPath := TSerialObj.Create;
  s4 := ConfigObj.GetObjByID(ID_FORMPOS, TSize4DataSet);
  if s4.DataCount > 0 then
  begin
    Left := s4.GetData(0);
    Top := s4.GetData(1);
    Width := s4.GetData(2);
    Height := s4.GetData(3);
  end;
  so := ConfigObj.GetObjByID(ID_INITPATH, TStringObj);
  leCurPath.Text := so.Str;
  RequestPath(so.Str);
end;

procedure TfrmHostFileSystem.FuncStop;
var
  s4: TSize4DataSet;
  so: TStringObj;
begin
  inherited;
  FreeAndNil(FCurPath);
  s4 := ConfigObj.GetObjByID(ID_FORMPOS, TSize4DataSet);
  s4.SetData(0, Left);
  s4.SetData(1, Top);
  s4.SetData(2, Width);
  s4.SetData(3, Height);
  so := ConfigObj.GetObjByID(ID_INITPATH, TStringObj);
  so.Str := leCurPath.Text;
end;

procedure TfrmHostFileSystem.leCurPathKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_RETURN then
  begin
    RequestPath(leCurPath.Text);
    Key := 0;
  end;
end;

procedure TfrmHostFileSystem.lvPathContentDblClick(Sender: TObject);
var
  fp: TFilePath;
  s: CommonString;
  i: integer;
begin
  if (lvPathContent.Selected <> nil) then
  begin
    fp := lvPathContent.Selected.Data;
    if (fp <> nil) and (fp.ClassID = CLASSID_SHAREFILEPATH) then
    begin
      if fp.Caption = '..' then
      begin
        s := leCurPath.Text;
        if (s <> '') and (s[Length(s)] = PathDelim) then
          Delete(s, Length(s), 1);
        i := RightPos(PathDelim, s);
        if i <> 0 then
          Delete(s, i + 1, Length(s))
        else
          s := '';
      end
      else
        s := RegularPath(leCurPath.Text) + fp.Caption;
      RequestPath(s);
    end
    else
      bOKClick(bOK);
  end;
end;

procedure TfrmHostFileSystem.ProcHostFileSystem(msg: TMsg);
var
  obj: TSerialObj;
  fp: TFilePath absolute obj;
  fi: TFileInfo absolute obj;
  li: TListItem;
begin
  ObjPool.ReturnChildObj(FCurPath, Self);
  lvPathContent.Items.BeginUpdate;
  lvPathContent.Items.Clear;
  lvPathContent.ViewStyle := vsIcon;
  while msg.Count > 0 do
  begin
    fp := msg.Param(TFilePath);
    if fp <> nil then
    begin
      li := lvPathContent.Items.Add;
      if (Length(fp.Caption) >= 2) and (fp.Caption[2] = ':') then
        li.ImageIndex := 0
      else
        li.ImageIndex := 1;
      li.Caption := fp.Caption;
      li.Data := fp;
      FCurPath.AddObj(fp);
    end
    else
      Break;
  end;
  while msg.Count > 0 do
  begin
    fi := msg.Param(TFileInfo);
    if fi <> nil then
    begin
      li := lvPathContent.Items.Add;
      li.ImageIndex := 2;
      li.Caption := fi.Caption;
      li.Data := fi;
      FCurPath.AddObj(fi);
    end
    else
      Break;
  end;
  lvPathContent.Items.EndUpdate;
  leCurPath.Text := msg.Caption;
end;

procedure TfrmHostFileSystem.RequestPath(path: CommonString);
var
  nv: TCommonNameValue;
begin
  nv := ObjPool.GetObj(TCommonNameValue, Self);
  nv.ObjID := ID_HOSTFILESYSTEM;
  if FOnlyDir then
    nv.Value := path + ';'
  else
    nv.Value := path;
  AddRecord(PeerHost, ID_HOSTPARAMTABLE, nv);
end;

end.
